home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / printing / frntback.lzh / FRNTBACK.PAS < prev    next >
Pascal/Delphi Source File  |  1988-06-05  |  25KB  |  636 lines
  1. { Copyright 1988 COMPUTE! Publications, Inc.  All rights reserved. }
  2. {$A+,D-,S3 }
  3. PROGRAM front_and_back ;
  4. CONST
  5.         {$I d:\p_pascal\gemconst.pas}
  6.         {$I D:\frntback.i }
  7.     AC_OPEN = 40 ;
  8.     AC_CLOSE= 41 ;
  9.  
  10. TYPE
  11.         {$I d:\p_pascal\gemtype.pas}
  12.  
  13.   VAR
  14.     msg        : message_buffer ;  { GEM events buffer }
  15.  
  16.         junk_title : Window_Title ;    { just a place holder }
  17.     title      : Str255 ;          { desk menu title }
  18.         ap_id,                         { application no. for accessory register
  19. }
  20.         wind_type,                     { just a place holder }
  21.         my_window  : Integer ;         { window identifier }
  22.  
  23.         in_name,                       { file name }
  24.         in_path    : Path_Name ;       { path name }
  25.  
  26.     dummy,                         { throw-away value }
  27.         rez,                           { resolution }
  28.         lm,                            { left margin }
  29.         tm,                            { top margin }
  30.         bm,                            { bottom margin }
  31.         form_len,                      { lines per page }
  32.         sp,                            { starting page }
  33.         ep,                            { ending page }
  34.         pg_offset  : Integer ;         { header pg no. }
  35.         print_init,                    { printer initiation string }
  36.         header_str : Str255 ;          { header string }
  37.  
  38.         rsc_found,                     { successful resource load? }
  39.         odd_pages,                     { print front pages? }
  40.         all_pages,                     { print both front & back pages? }
  41.         pauz       : Boolean ;         { page wait? }
  42.  
  43.         {$I d:\p_pascal\gemsubs.pas}
  44.  
  45. (*****************************************************************************)
  46. { The following declarations have to be made in SOME versions of }
  47. {       Personal Pascal.  They are commented out here. If you get an }
  48. {       undeclared identifier error, remove the curly brackets and   }
  49. {       allow these declarations to be included.                     }
  50.  
  51. {
  52. PROCEDURE IO_Check( flag : boolean ) ;
  53.    EXTERNAL ;
  54. FUNCTION IO_Result : Integer ;
  55.    EXTERNAL ;
  56. }
  57. (*****************************************************************************)
  58.  
  59. FUNCTION Menu_Register( id: Integer ; VAR name : Str255 ) : Integer ;
  60. { installs application as desk accessory }
  61.     EXTERNAL ;
  62.  
  63. (*****************************************************************************)
  64. { External form handling declarations }
  65.  
  66. PROCEDURE Obj_Draw( dialog : Dialog_Ptr ;
  67.                                         start, depth,
  68.                                         x,y,w,h : Integer ) ;
  69.         EXTERNAL ;
  70.  
  71. FUNCTION Obj_Find( dialog : Dialog_Ptr ;
  72.                     start, depth,
  73.                     mx,my : Integer ) : Integer ;
  74.         EXTERNAL ;
  75.  
  76. (*****************************************************************************)
  77.  
  78. PROCEDURE int_to_str ( n : Integer;  VAR s : String ) ;
  79.   { Converts integer n to char string  s. }
  80.  
  81.   PROCEDURE itoc( n1 : Integer;  VAR s1 : String ) ;
  82.    { Recursively converts digits of an integer into characters in a string. }
  83.  
  84.   BEGIN
  85.         IF ( n1 < 0 ) THEN BEGIN
  86.                 s1 := '-' ;
  87.                 itoc( ABS( n1 ), s )
  88.         END
  89.         ELSE BEGIN
  90.                 IF ( n1 >= 10 ) THEN
  91.                         itoc( n1 DIV 10, s1 ) ;
  92.                 s1 := Concat( s1, chr( n1 MOD 10 + ORD( '0' ) ) )
  93.         END
  94.   END ; { itoc }
  95.  
  96. BEGIN { int_to_str }
  97.         s := '' ;
  98.         itoc( n, s )
  99. END ; { int_to_str }
  100.  
  101. FUNCTION str_to_int( VAR s : String ) : Integer ;
  102.   { Convert ascii string to integer. Catches Long_Integer }
  103.   { entries and truncates to maximum integer ( 32,767 )   }
  104.  
  105. VAR
  106.         sign : Integer ;
  107.         n    : Long_Integer ;
  108. BEGIN
  109.         WHILE NOT ( s[1] IN [ '0'..'9', '-', '+' ] ) AND ( length( s ) > 0 ) DO
  110.                 Delete( s, 1, 1 ) ;
  111.         IF ( s[1] = '-' ) THEN
  112.                 sign := -1
  113.         ELSE
  114.                 sign := 1 ;
  115.         IF s[1] IN [ '+', '-' ]  THEN
  116.                 Delete( s, 1, 1 ) ;
  117.         n := 0 ;
  118.         WHILE ( s[1] IN [ '0' .. '9' ] ) AND ( length( s ) > 0 ) DO BEGIN
  119.                 n := 10 * n + ( ORD( s[1]) - ORD( '0' ) ) ;
  120.                 Delete( s, 1, 1 ) ;
  121.         END;
  122.         IF n > 32767 THEN
  123.                 n := 32767 ;
  124.         str_to_int := sign * Int( n ) ;
  125. END ; { str_to_int }
  126.  
  127. PROCEDURE refresh_screen ;
  128. { Puts a fresh coat of paint on the screen. }
  129. VAR
  130.         x, y, w, h       : Integer ;
  131.         wx, wy, ww, wh   : Integer ;
  132.  
  133. BEGIN { refresh_screen }
  134.         hide_mouse ;
  135.         draw_mode( 1 ) ;
  136.         Paint_Color( GREEN ) ;
  137.         Paint_Outline( FALSE ) ;
  138.         First_Rect( my_window, x, y, w, h ) ;
  139.         Work_Rect( my_window, wx,wy,ww,wh ) ;
  140.         set_clip( wx, wy, ww, wh ) ;
  141.         WHILE ( w <> 0 ) AND ( h <> 0 ) DO BEGIN
  142.                 IF Rect_Intersect( wx, wy, ww, wh, x, y, w, h) THEN BEGIN
  143.                         IF rez = 2 THEN
  144.                                 Paint_Style(5)
  145.                         ELSE
  146.                                 Paint_Style(1) ;
  147.                         Paint_Rect( x,y,w,h ) ;
  148.                 END ;
  149.                 Next_Rect( my_window, x, y, w, h ) ;
  150.         END ; { while }
  151.         show_mouse ;
  152. END { refresh_screen };
  153.  
  154. PROCEDURE draw_dialog( which : Integer ) ;
  155. { Finds 'which' dialog in the resource, and draws it. }
  156. VAR
  157.         dialog  : Dialog_Ptr ;
  158.         x,y,w,h : Integer ;
  159.  
  160. BEGIN { draw_dialog }
  161.                 Find_Dialog( which, dialog ) ;
  162.                 Center_Dialog( dialog ) ;
  163.                 Work_Rect( my_window, x,y,w,h ) ;
  164.                 Obj_Draw( dialog, 0,15, x,y,w,h ) ;
  165. END ; { draw_dialog }
  166.  
  167. FUNCTION cancel_box( dialog : Dialog_Ptr ) : Boolean ;
  168. { Do we want to cancel printing operation? }
  169. VAR
  170.         mx, my,
  171.         junk,
  172.         which  : Integer ;
  173.         alert  : Str255 ;
  174.  
  175. BEGIN
  176.         cancel_box := FALSE ;
  177.         which := Get_Event( E_TIMER | E_BUTTON | E_Message, 1, 1, 0, 0,
  178.                                                         FALSE, 0, 0, 0, 0,
  179. FALSE, 0, 0, 0, 0,
  180.                                                         msg, junk, junk, junk,
  181. mx, my, junk ) ;
  182.         IF which & E_BUTTON <> 0 THEN BEGIN
  183.                 IF  Obj_Find( dialog,0,15, mx,my ) = ABORT THEN BEGIN
  184.                         Obj_SetState( dialog, ABORT, SELECTED,TRUE ) ;
  185.                         end_dialog( dialog ) ;
  186.                         refresh_screen ;
  187.                         Obj_SetState( dialog, ABORT, NORMAL,FALSE ) ;
  188.                         find_alert( FORSURE, alert ) ;
  189.                         IF do_alert( alert,1 ) = 1 THEN
  190.                                 cancel_box := TRUE
  191.                         ELSE BEGIN
  192.                                 cancel_box := FALSE ;
  193.                                 draw_dialog( PROGRESS ) ;
  194.                         END ;
  195.                 END ;
  196.         END ;
  197. END ; { cancel_box }
  198.  
  199. PROCEDURE home_path( VAR path : Path_name ) ;
  200. { Builds a path name from whence we were launched. }
  201. VAR
  202.         temp : String ;
  203.         ctr : Integer ;
  204.  
  205.   FUNCTION getdrv : Integer ;
  206.         GEMDOS( $19 ) ;
  207.  
  208.   PROCEDURE getdir( VAR buffer : String ; drive : Integer ) ;
  209.         GEMDOS( $47 ) ;
  210.  
  211. BEGIN { home_path }
  212.         path := Concat ( chr( getdrv + ORD('A') ), ':' ) ;
  213.         getdir( temp, 0 ) ;
  214.         ctr := 0 ;
  215.         WHILE ORD( temp[ctr]) <> 0 DO BEGIN
  216.                 path := Concat( path, temp[ctr] ) ;
  217.                 ctr := ctr+1 ;
  218.         END ;
  219. END ; { home_path }
  220.  
  221. PROCEDURE initiate ;
  222. { Let's get something straight... }
  223.  
  224.   FUNCTION getrez : Integer ;
  225.         XBIOS( 4 ) ;
  226.  
  227. BEGIN
  228.         wind_type := NONE ;
  229.         rez := Getrez ;
  230.         in_name := '' ;
  231.         home_path( in_path ) ;
  232.         in_path := Concat( in_path, '\*.*' ) ;
  233.         lm := 0 ;
  234.         tm := 0 ;
  235.         bm := 0 ;
  236.         form_len := 65 ;
  237.         sp := 1 ;
  238.         ep := 32767 ;
  239.         pg_offset := 0 ;
  240.         print_init := '' ;
  241.         header_str := '' ;
  242.         odd_pages :=